*
* $Id$
*
* $Log: ertrgo.F,v $
* Revision 1.1.1.1  2002/06/16 15:18:35  hristov
* Separate distribution  of Geant3
*
* Revision 1.1.1.1  1999/05/18 15:55:15  fca
* AliRoot sources
*
* Revision 1.1.1.1  1996/03/06 15:37:35  mclareni
* Add geane321 source directories
*
*
#include "geant321/pilot.h"
*CMZ :  3.21/02 29/03/94  15.41.49  by  S.Giani
*-- Author :
      SUBROUTINE ERTRGO
*
C.    ******************************************************************
C.    *                                                                *
C.    *       Perform the tracking of the track                        *
C.    *       Track parameters are in VECT                             *
C.    *                                                                *
C.    *    ==>Called by : ERTRAK                                       *
C.    *       Original routines : GTRACK + GTVOL                       *
C.    *       Authors   M.Maire, E.Nagy  *********                     *
C.    *                                                                *
C.    ******************************************************************
C.
#include "geant321/gcbank.inc"
#include "geant321/gcjloc.inc"
#include "geant321/gccuts.inc"
#include "geant321/gconst.inc"
#include "geant321/gcphys.inc"
#include "geant321/gckine.inc"
#include "geant321/gcflag.inc"
#include "geant321/gctmed.inc"
#include "geant321/gcmate.inc"
#include "geant321/gctrak.inc"
#include "geant321/gcvolu.inc"
#include "geant321/gcunit.inc"
#include "geant321/gcnum.inc"
#include "geant321/ertrio.inc"
#include "geant321/erwork.inc"
      COMMON/GCCHAN/LSAMVL
      LOGICAL LSAMVL
*
*
#ifndef SINGLEFIELD
      DOUBLE PRECISION VECTD(3), HID(3)
#endif
      DIMENSION CUTS(10),MECA(5,12)
      EQUIVALENCE (CUTS(1),CUTGAM),(MECA(1,1),IPAIR)
      DIMENSION NAMIN(15),NUMIN(15),NAMOUT(15),NUMOUT(15)
*
      SAVE PRECOR,NSTOUT
#if (!defined(CERNLIB_SINGLE))&&(!defined(CERNLIB_IBM))
      PARAMETER (EPSMAC=5.E-6)
#endif
#if (!defined(CERNLIB_SINGLE))&&(defined(CERNLIB_IBM))
      PARAMETER (EPSMAC=5.E-5)
#endif
#if defined(CERNLIB_SINGLE)
      PARAMETER (EPSMAC=1.E-11)
#endif
C.
C.    ------------------------------------------------------------------
*
      NSTOUT = 0
      EPSCUR = EPSMAC
      LSAMVL = .FALSE.
      SLENG  = 0.
      ISTOP  = 0
      NUMED  = 0
      NUMOLD = 0
      IUPD   = 0
      NMEC   = 0
      INGOTO = 0
      INFROM = 0
      SAFETY = 0.
      MXNSTP = 1000
      NSTEP  = 0
*
      CALL GMEDIA(VECT,NUMED)
      IF (NUMED.EQ.0) GO TO 200
*
* *** Come back here each time we enter into a new volume
*
   10 CONTINUE
*
* *** Get tracking medium and material parameters
      IF (NUMED.NE.NUMOLD) THEN
         NUMOLD = NUMED
         IUPD   = 0
         JTM = LQ(JTMED- NUMED)
         DO 20 I=1,5
            NATMED(I)=IQ(JTM+I)
  20     CONTINUE
         NMAT   = Q(JTM + 6)
         ISVOL  = Q(JTM + 7)
         IFIELD = Q(JTM + 8)
         FIELDM = Q(JTM + 9)
         TMAXFD = Q(JTM + 10)
         DMAXMS = Q(JTM + 11)
         DEEMAX = Q(JTM + 12)
         EPSIL  = Q(JTM + 13)
         STMIN  = Q(JTM + 14)
         PRECOR   = MIN(0.1*EPSIL, 0.0010)
*
         IF(LQ(JTM).EQ.0)THEN
            IF(ISTPAR.NE.0)THEN
               DO 30 I=1,10
                  CUTS(I)=Q(JTMED+I)
  30           CONTINUE
               DO 40 I=1,12
                  MECA(1,I)=Q(JTMED+10+I)
  40           CONTINUE
               ISTPAR=0
            ENDIF
         ELSE
            JTMN=LQ(JTM)
            DO 50 I=1,10
               CUTS(I)=Q(JTMN+I)
  50        CONTINUE
            DO 60 I=1,12
               MECA(1,I)=Q(JTMN+10+I)
  60        CONTINUE
            ILABS = Q(JTMN+10+21)
            ISYNC = Q(JTMN+10+22)
            ISTRA = Q(JTMN+10+23)
            ISTPAR=1
         ENDIF
*
         JMA  = LQ(JMATE- NMAT)
         JPROB=LQ(JMA-4)
         JMIXT=LQ(JMA-5)
         DO 70 I=1,5
  70     NAMATE(I)=IQ(JMA+I)
         A    = Q(JMA + 6)
         Z    = Q(JMA + 7)
         DENS = Q(JMA + 8)
         RADL = Q(JMA + 9)
         ABSL = Q(JMA + 10)
      ENDIF
*
      IF(LSAMVL) THEN
*
*       If now the particle is entering in the same volume where
*       it was exiting from last step, and if it has done this for
*       more than 5 times, we decrease the precision of tracking
         NSTOUT=NSTOUT+1
         IF(MOD(NSTOUT,5).EQ.0) THEN
            EPSCUR=NSTOUT*EPSMAC
            WRITE(CHMAIL,10000)ITRA,ISTAK,NTMULT,NAPART
10000          FORMAT(' *** ERTRGO *** Boundary loop: track ',
     +         I4,' stack ',I4,' NTMULT ',I5,1X,5A4)
            CALL GMAIL(1,0)
            WRITE(CHMAIL,10100) EPSCUR
10100          FORMAT('                Precision now set to ',G10.3)
            CALL GMAIL(0,1)
         ENDIF
      ELSE
         NSTOUT = 0
         EPSCUR = EPSMAC
      ENDIF
*
* *** Initialize magnetic field for EMC package
      HI(1) = 0.
      HI(2) = 0.
      HI(3) = 0.
      IF (IFIELD.EQ.3) THEN
         HI(3) = FIELDM
      ELSEIF (IFIELD.NE.0) THEN
#ifdef SINGLEFIELD
         CALL GUFLD (VECT, HI)
#else
         DO J=1,3
            VECTD(J)=VECT(J)
         END DO
         CALL GUFLD(VECTD,HID)
         DO J=1,3
            HI(J)=HID(J)
         ENDDO
#endif
      ENDIF
*
* *** Control given to user at entrance of volume (INWVOL=1)
      INWVOL = 1
      NMEC   = 1
      LMEC(1) = 29
      STEP   = 0.
      DESTEP = 0.
*
      IF((LEVOLU).AND.(SLENG.GT.0.)) THEN
         IMEC = 0
         CALL EVOLIO(NVLIN,NAMIN,NUMIN,NVLOUT,NAMOUT,NUMOUT)
         DO 80 IPR =1,NEPRED
            NAMPR = NAMEER(IPR)
            NUMPR = NUMVER(IPR)
            IOVPR = IOVLER(IPR)
            IF (IOVPR.EQ.1) THEN
               IV = IUCOMP(NAMPR,NAMIN ,NVLIN )
               IF (IV.NE.0) THEN
                  IF (NUMPR.EQ.0) NUMPR = NUMIN (IV)
                  IF (NUMPR.EQ.NUMIN (IV)) THEN
                     NMEC = NMEC + 1
                     LMEC(NMEC) = 27
                     INLIST = IPR
                     CALL ERSTOR
                  ENDIF
               ENDIF
            ELSE IF (IOVPR.EQ.2) THEN
               IV = IUCOMP(NAMPR,NAMOUT,NVLOUT)
               IF (IV.NE.0) THEN
                  IF (NUMPR.EQ.0) NUMPR = NUMOUT(IV)
                  IF (NUMPR.EQ.NUMOUT(IV)) THEN
                     NMEC = NMEC + 1
                     LMEC(NMEC) = 27
                     INLIST = IPR
                     CALL ERSTOR
                  ENDIF
               ENDIF
            ENDIF
*
   80    CONTINUE
*
      ENDIF
*
      CALL EUSTEP
      IF (ISTOP.NE.0) GO TO 999
*
* *** Particle is propagated up to the next volume boundary
*
      INWVOL=0
*
* *** Come back here after each step in the same volume
 100  IGNEXT = 0
      INGOTO = 0
      NLEVIN = NLEVEL
      NMEC   = 0
      STEP   = 0.
      DESTEP = 0.
      DEDX2  = 0.
      PREC   = MAX(PRECOR,MAX(ABS(VECT(1)),ABS(VECT(2)),
     +                        ABS(VECT(3)),SLENG)*EPSCUR)
*
      IF(CHARGE.NE.0.) THEN
         CALL ERTRCH
      ELSE
         CALL ERTRNT
      ENDIF
*
      NSTEP  = NSTEP + 1
      IF (NSTEP.GT.MXNSTP) THEN
         ISTOP = 99
         NMEC  = NMEC + 1
         LMEC(NMEC) = 30
      ENDIF
*
      SAFETY = SAFETY - STEP
      TLRAD  = TLRAD  + STEP/RADL
      TLGCM2 = TLGCM2 + STEP*DENS
*
* *** Give control to user after each tracking step
      CALL EUSTEP
*
      IF(ISTOP.NE.0) GO TO 999
*
* *** Renormalize direction cosines
      CMOD = 1./SQRT(VECT(4)**2 + VECT(5)**2 + VECT(6)**2)
      VECT(4) = VECT(4)*CMOD
      VECT(5) = VECT(5)*CMOD
      VECT(6) = VECT(6)*CMOD
*
      IF (INWVOL.EQ.0) GO TO 100
*
* *** Particle is leaving the volume (INWVOL=2) :
*
*     Save the current volume's tree before leaving the volume
      IF(LEVOLU) CALL EVOLIO(NVLIN,NAMIN,NUMIN,NVLOUT,NAMOUT,NUMOUT)
*
*     find the new volume
      IF (NLEVIN.GE.NLEVEL) THEN
         INFROM = 0
      ELSE
         IF (NLEVIN.EQ.0) GO TO 200
         INFROM = LINDEX (NLEVIN+1)
      ENDIF
      IF (NLEVIN.NE.NLEVEL) INGOTO = 0
      NLEVEL = NLEVIN
*
      CALL GTMEDI (VECT,NUMED)
      IF (NUMED.NE.0) THEN
         SAFETY = 0.
         GO TO 10
      ENDIF
*
* *** Track outside setup, give control to user (INWVOL=3)
  200 INWVOL= 3
      ISTOP = 1
      NMEC  = NMEC + 1
      LMEC(NMEC) = 30
      CALL EUSTEP
 999  CONTINUE
      ILOSL = 0
*
      END
